home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / tprint.zip / TESTPRN1.PAS < prev    next >
Pascal/Delphi Source File  |  1991-05-10  |  2KB  |  94 lines
  1. PROGRAM TestPrn;
  2. {$F+}
  3. {-- Sample program using the printer unit --}
  4.  
  5. Uses wObjects,winProcs,printer,stdDlgs,WinTypes,Strings;
  6. const
  7.   cmSetPrint = 1;
  8.   cmPrintFile = 2;
  9.  
  10. TYPE
  11.   tTestApp = object(tApplication)
  12.     procedure InitMainWindow; virtual;
  13.   end;
  14.  
  15.   pPrnWindow = ^tPrnWindow;
  16.   tPrnWindow = object(tWindow)
  17.     aPrinter: pPrinter;
  18.     constructor Init(aParent: pWindowsObject;aTitle: pChar);
  19.     procedure   setPrinter(var msg:tMessage);virtual cm_first + cmSetPrint;
  20.     procedure   filePrint(var msg: tMessage);virtual cm_first + cmPrintFile;
  21.   end;
  22.   pathStr = array[0..64] of Char;
  23.  
  24.  
  25. {$R test.res}
  26.  
  27. procedure tPrnWindow.setPrinter(var msg:tMessage);
  28. begin
  29.   aPrinter := new(pPrinter,Init(hInstance,@self));
  30.   aPrinter^.prnDeviceMode(hWindow);
  31.   dispose(aPrinter,Done);
  32. End;
  33.  
  34. Function fileIsOpen(var t: Text;f: pathStr): Boolean;
  35. var
  36.   ioCode: integer;
  37. Begin
  38. {$I-}
  39.   assign(t,f);
  40.   reset(t);
  41.   ioCode := ioResult;
  42.   fileIsOpen := (ioCode = 0);
  43. {$I+}
  44. end;
  45.  
  46. procedure tPrnWindow.filePrint(var msg: tMessage);
  47. {-- Gets a file name from the user, and prints it out. (the file, not
  48.     the file name --}
  49. var
  50.   fName: pathStr;
  51.   textFile: Text;
  52.   tLine: array[0..79] of char;
  53.  
  54. Begin
  55.   fName[0] := ' ';
  56.   if (Application^.ExecDialog(new(pInputDialog,Init(@self,'File to Print',
  57.          'Enter File Name: ',fName,SizeOf(fName)))) = id_OK) then begin
  58.     if (FileIsOpen(textFile,fName)) then begin
  59.  
  60.       aPrinter := new(pPrinter,Init(hInstance,@self));          {init the printer object}
  61.       if aPrinter^.Start('PrnTest',hWindow) then begin  {start the printer}
  62.         while not eof(textFile) do begin
  63.           readln(textFile,tLine);
  64.           aPrinter^.printLine(@tLine);     {send each line to the printer object}
  65.         End;
  66.         close(textFile);
  67.         aPrinter^.Finish;                {finish the print job}
  68.         dispose(aPrinter,Done);
  69.       End;
  70.     End;
  71.   End;
  72. end;
  73.  
  74. constructor tPrnWindow.Init(aParent: pWindowsObject;aTitle: pChar);
  75. begin
  76.   tWindow.Init(aParent,aTitle);
  77.   Attr.Style := WS_OverlappedWindow or ws_Vscroll or WS_Hscroll;
  78.   attr.Menu := loadMenu(hInstance,pChar(100));
  79. end;
  80.  
  81. Procedure tTestApp.InitMainWindow;
  82. Begin
  83.   MainWindow := new(pPrnWindow,init(nil,'Printer Test'));
  84. End;
  85.  
  86.  
  87. var
  88.   tApp: tTestApp;
  89.  
  90. Begin
  91.   tApp.Init('Printer Test');
  92.   tApp.Run;
  93.   tApp.Done;
  94. End.